perm filename PLTCMX.F4[MSS,LCS] blob sn#128704 filedate 1974-11-06 generic text, type T, neo UTF8
00100	C**** PLTCMD, FILLMS, ROTATE  *********
38876		SUBROUTINE PLTCMD
39028		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK
39104		DIMENSION NMS(8),RMOV1(8),RMOV2(8)
39180		COMMON /DL/RSIZ,SAVER,NAME /ALF/INP(72),ML
39256		COMMON RJB,JE,CENTR,JB,RJQ(20),JQ(20)
39332		EQUIVALENCE (RJE,RJQ(3)),(RJF,RJQ(4)),(RJG,RJQ(5)),(RJD,RJQ(2))
39408		1,(RJC,RJQ(1)),(I2,INP(2)),(RJH,RJQ(6)),(NMS(1),INP(31))
39484		1,(RMOV1(1),INP(39))
39560	C  BE CAREFUL OF COMMON OVERLAPS WITH NOTWRT,ITMSUB,HOMER, ETC.
39712		F78F(1)='(78F)'
39788		FA5(1)='(A5) '
39864		FA1(1)='(A1) '
40000	
40100		IF(I2.NE.'X')GO TO 1
40150	CC	ML=' '
40200		I2=0
40300		RXC=0
40400		RMOV1(1)='Y'
40500		NAME=0
40600	14	KA=0
40700	3	KA=KA+1
40710	CC	IF(ML.EQ.' ')GO TO 15
40715		IF(ML.EQ.0)GO TO 15
40720		K=K-2
40725		ML=ML-1
40730		IF(ML.EQ.0)GO TO 10
40740		GO TO 31
40800	15	TYPE 2,KA
40900		ACCEPT 11,K,ML
40950	C  TYPE LAST NAME, NUMBER  FOR A SERIES
41000	50	IF(K.EQ.' ')GO TO 10
41100		IF(K.EQ.'99')GO TO 140
41200	C  99=BACKUP
41300	31	IF(LOOKD(K))GO TO 56
41400	C JUMP IF FILE FOUND
41500		TYPE 55
41600		GO TO 15
41700	55	FORMAT(' FILE NOT FOUND'/)
41750	11	FORMAT(A5,I)
41800	56	NMS(KA)=K
41810	CC	IF(ML.EQ.' ')GO TO 5
41820		IF(ML.EQ.0)GO TO 5
41855		RJH='Y'
41877		GO TO 21
41900	5	TYPE 8
42000		ACCEPT FA5,RJH
42100		IF(RJH.EQ.'99')GO TO 15
42200		IF(RJH.NE.'Y')RJH=0
42300		IF(RJH.EQ.0)REREAD F78F,RJH
42400	C  MOVE NUMBER CAN BE TYPED FOR 'MOVE UP'
42500	21	RMOV1(KA+1)=RJH
42600		RMOV2(KA)=RJH
42700		GO TO 3
42800	140	KA=KA-1
42900		GO TO 15
43000	
43100	10	KB=KA-1
43200	22	TYPE 9
43300		ACCEPT F78F,RSIZ
43400		IF(RSIZ.EQ.99.OR.RSIZ.EQ.0)GO TO 5
43500	222	KA=0
43600	
43700	1	IF(NAME.NE.0)GO TO 12
43800		IF(KA.EQ.KB)CALL PLOT(0,0,99)
43900		NAME=NMS(KA+1)
44000		TYPE 111,NAME
44100		RETURN
44200	12	KA=KA+1
44300		NAME=0
44400	CC	RJD=1
44500	CC	IF(INP(3).EQ.'C')RJD=0
44600	C  'PXC' = CALCOMP OUTPUT
44700		RJH=0
44800		RJB=RSIZ
44900		RJC=RSIZ
44920	CC	IXRX=RSIZ+.4
44960	C  FOR FILLER.  SIZES .LT. 1.6 = EVERY SCAN LINE, .LT. 2.6 = 2, ETC.
45000		RJG=0
45100		RJE=1
45200		RJF=1
45300		IF(RMOV2(KA).NE.'Y')RJG=RMOV2(KA)
45400		IF(RMOV1(KA).NE.0)RJE=0
45500		IF(RMOV2(KA).NE.0.OR.RJG.NE.0)RJF=0
45600	2	FORMAT(' TYPE FILE NAME',I2,1X$)
45700	8	FORMAT(' MOVE UP AT END? ',$)
45800	9	FORMAT(' SIZE FACTOR? ',$)
45900	111	FORMAT(1XA5/)
46000		END
60800	
62000	
63500	
65000	C******   CHANGE 3, 4 AND 5 TO JFCL IN DDT WHEN USING DISTORTION.(SEE 'LINES')
65100		SUBROUTINE FILLMS(L,IDAT,RJB,CENTR,RJF,RJG)
65200		COMMON/DL/RSIZ,SAVER,NAME
65300		COMMON/DST/BB,CC/FLM/X(200),Y(200),NX(200)
65400		DIMENSION IDAT(1)
65500		COMMON/PLTR/IPLT,RHT,DIS/LL/LL/STF/RR(8),RSTJC
65600	CC	DATA MP/2/,MD/6/
65700	C MD=DISPLAY   MP=PLOTTER   MX=XGP
65800		DX=DIS
65900		RX=RHT
66000		D=RSTJC*RJF
66100		R=RSTJC*RJG
66200	4	GO TO 1
66300		C=CC
66400		B=BB
66500	C  SAVES IT.  IT WILL RETURN LATER.
66600		BB=B/DIS
66700		CC=1000
66800	1	KK=0
66900		DO 205 J=1,L
67000		CALL UNPACK(M,N,IDAT(J))
67100		KK=KK+1
67200		NX(KK)=0
67300		IF(LL.EQ.3)NX(KK)=3
67400		X(KK)=ROFF((RJB+D*M)*DIS)
67500		Y(KK)=ROFF((CENTR+R*N)*RHT)
67600	3	GO TO 205
67700		Y(KK)=Y(KK)*(C-BB*(ABS(X(KK))))
67800	C  FOR DISTORTION
67900	205	CONTINUE
68000		NX(1)=KK
68100		DIS=1.0
68200		RHT=DIS
68300	CC	M=MD
68350	CC	M=IXRX
68400	CC	IF(IPLT)M=MP-IXRX
68450		IF(IPLT)M=RSIZ+.4
68475		IF(M.LE.0)M=1
68500	C  STOPS DISTORTION IN 'LINES'
68600	2	CALL FILLER(X,Y,NX,M)
68700		DIS=DX
68800		RHT=RX
68900	5	RETURN
69000	C  NEXT TO RESET DISTORTION FACT.
69100		BB=B
69200		CC=C
69300		RETURN
69400		END
69500	
69600		SUBROUTINE ROTATE(I,L)
69700		DIMENSION I(1)
69800	CC	COMMON/LL/LL
69900		COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)/STF/RR(8),RSTJC
70000		EQUIVALENCE (RJF,RJQ(4)),(RJG,RJQ(5)),(DEG,RJQ(7))
70100		RJG=RJG*RSTJC
70200		RJF=RJF*RSTJC
70300		N=I(L)
70400		KNT=601
70500	C  ROTATED DATA IS PUT BACK STARTING AT LOCATION 601.
70600		I(KNT)=N
70700		DO 1 K=L+1,N+L-1
70800		CALL UNPACK(J,M,I(K))
70900		X=J*RJF
71000		Y=M*RJG
71100		JJ=I(K)/100000000
71200		AX=ATAN2(X,Y)*57.29578
71300		HYP=SQRT(X**2+Y**2)
71400		ROT=DEG+AX
71500		J=ROFF(HYP*COSD(ROT))
71600		M=ROFF(HYP*SIND(ROT))
71700		KNT=KNT+1
71800		IF(J)J=1000-J
71900		IF(M)M=1000-M
72000	1	I(KNT)=M*10000+J+JJ*100000000
72100		L=601
72200		RJF=1.
72300		RJG=1.
72400		RSTJC=1.
72500	C  SIZE CHANGES MUST BE MADE BEFORE ROTATION!!!!! ELSE IT DISTORTS.
72600		END